home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0091_Re: Virtual Reality..pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  3KB  |  133 lines
  1. {
  2. RE: Re: Virtual Reality.
  3. BY: Bas van Gaalen to John Shipley on Fri Mar 25 1994 02:26 pm
  4.  
  5.  > John Shipley wrote in a message to Bas van Gaalen:
  6.  > 
  7.  >  > I posted it recently, so you must have seen it passing by...
  8.  >  JS> You did? I read just about every post you write, I didn't
  9.  >  JS> see any program by that name come by here.
  10.  > 
  11.  > I suppose it got lost. You're the second... Anyway, I posted it again. Check
  12.  > previous message... It should be there.
  13.  
  14. Hello Bas!
  15.  
  16. Yes, I got it today... basically the problem I saw with the code was lack of
  17. optimization and it also looked like you were trying to do too much. You
  18. didn't need all the asm. But it could be even faster if you included it. I'm
  19. sending back my modified version of your DYCP program. The "writecharasm"
  20. procedure was screwed up so I removed it and I will check it out at a later
  21. time. I modified the "writechar" procedure which you had commented out.
  22.  
  23. -------8<---------Snip---------8<---------Snip---------8<--------Snip---------
  24.  
  25. {$G+}
  26. PROGRAM different_y_char_position;
  27.  
  28. (* Programmed by Bas van Gaalen, Holland, PD  *)
  29. (* Modified by John Shipley, USA, PD 03/30/94 *)
  30.  
  31. USES CRT;
  32.  
  33. CONST vseg : WORD   = $a000;
  34.       txt  : STRING = '**** Well... 38 chars, let''s see. ****';
  35.                    (*  12345678901234567890123456 78901234567890 *)
  36.       txt1 : STRING = 'This is another Strng of 38 Characters';
  37. VAR stab      : ARRAY[0..255] OF BYTE;
  38.     fseg,fofs : WORD;
  39.  
  40. PROCEDURE getfont; ASSEMBLER;
  41.   ASM
  42.     mov ax,1130h;
  43.     mov bh,1;
  44.     int 10h;
  45.     mov fseg,es;
  46.     mov fofs,bp;
  47.   END;
  48.  
  49. PROCEDURE csin;
  50.   VAR i : BYTE;
  51.   BEGIN
  52.     for i := 0 to 255 do stab[i] := round(sin(6*i*pi/255)*25)+40;(*150*)
  53.   END;
  54.  
  55. PROCEDURE clear(x,y: WORD); ASSEMBLER;
  56.   ASM
  57.     mov es,vseg
  58.     mov dx,0
  59.    @lout:
  60.     mov cx,0
  61.    @lin:
  62.     mov ax,y
  63.     add ax,dx
  64.     shl ax,6
  65.     mov di,ax
  66.     shl ax,2
  67.     add di,ax
  68.     add di,x
  69.     add di,cx
  70.     xor ax,ax
  71.     mov [es:di],ax
  72.     add cx,2
  73.     cmp cx,8
  74.     jne @lin
  75.     inc dx
  76.     cmp dx,2 (* Was 8 *)
  77.     jne @lout
  78.   END;
  79.  
  80. PROCEDURE writechar(ch: CHAR; x,y: WORD; col: BYTE);
  81.   VAR j,k : BYTE;
  82.       pre : WORD;
  83.       opt : WORD;
  84.   BEGIN
  85.     pre := BYTE(ch)*8; (* Opt *)
  86.     clear(x,y-2);      (* Key *)
  87.     FOR j:=0 TO 7 DO
  88.       FOR k:=0 TO 7 DO
  89.         BEGIN
  90.           opt := (y+j)*320+x+k;  (* Opt *)
  91.           IF ((MEM[fseg:fofs+pre+j] SHL k) AND 128)=0 THEN
  92.             MEM[$a000:opt] := 0 (* Key *)
  93.           ELSE
  94.             MEM[$a000:opt] := col;
  95.         END;
  96.     INC(y,8);   (* Opt *)
  97.     clear(x,y); (* Key *)
  98.   END;
  99.  
  100. PROCEDURE dodycp;
  101.   VAR sctr,i,l: BYTE;
  102.       a,b,c : WORD;
  103.   BEGIN
  104.     sctr := 0;
  105.     l := LENGTH(txt); (* Opt *)
  106.     REPEAT
  107.       WHILE (PORT[$3da] AND 8)<>0 DO;
  108.       WHILE (PORT[$3da] AND 8)=0 DO;
  109.       FOR i := 1 TO l DO
  110.         BEGIN
  111.           a := i*8;
  112.           b := stab[(sctr+2*i) MOD 255];
  113.           c := stab[sctr+i] MOD 64;
  114.           INC(c,32);
  115.           writechar(txt[i],a,b,c);
  116.           INC(b,110);
  117.           writechar(txt1[i],a,b,c);
  118.         END;
  119.       INC(sctr);
  120.     UNTIL KEYPRESSED;
  121.   END;
  122.  
  123. BEGIN
  124.   getfont;
  125.   csin;
  126.   ASM
  127.     mov ax,13h;
  128.     int 10h;
  129.   END;
  130.   dodycp;
  131.   TEXTMODE(lastmode);
  132. END.
  133.